home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE16 / RTTI / ClaForm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-29  |  16.3 KB  |  517 lines
  1. unit ClaForm;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, Classes, Graphics, Controls, Forms,
  7.   StdCtrls, ExtCtrls, Buttons, Clipbrd, Comctrls, Db, Dbcgrids,
  8.   Dbctrls, Dbgrids, Dblookup, DbTables, Ddeman, Dialogs,
  9.   Filectrl, Grids, Mask, Menus, Mplayer, Olectnrs,
  10.   Outline, Report, Tabnotbk, Tabs, IniFiles, Printers,
  11.   Registry, DsgnIntf, TypInfo;
  12.  
  13. type
  14.   TForm1 = class(TForm)
  15.     Listbox1: TListBox;
  16.     ListBox2: TListBox;
  17.     Label1: TLabel;
  18.     procedure Listbox1Click(Sender: TObject);
  19.     procedure FormCreate(Sender: TObject);
  20.     procedure ListBox2Click(Sender: TObject);
  21.   public
  22.     procedure AddType (pti: PTypeInfo);
  23.   end;
  24.  
  25.   procedure ShowClass (pti: PTypeInfo; sList: TStrings);
  26.   // repeated from TypInfo.Pas
  27.   procedure SortPropList(PropList: PPropList; PropCount: Integer);
  28.  
  29. var
  30.   Form1: TForm1;
  31.  
  32. implementation
  33.  
  34. {$R *.DFM}
  35.  
  36. procedure TForm1.Listbox1Click(Sender: TObject);
  37. var
  38.   pti: PTypeInfo;
  39. begin
  40.   pti := PTypeInfo (ListBox1.Items.Objects [
  41.     Listbox1.ItemIndex]);
  42.   ListBox2.Items.Clear;
  43.   Label1.Caption := 'RTTI information for ' +
  44.     ListBox1.Items [Listbox1.ItemIndex];
  45.   ShowClass (pti, ListBox2.Items);
  46. end;
  47.  
  48. // show RTTI information for class type
  49. procedure ShowClass (pti: PTypeInfo; sList: TStrings);
  50. var
  51.   ptd: PTypeData;
  52.   ppi: PPropInfo;
  53.   pProps: PPropList;
  54.   nProps, I: Integer;
  55.   ParentClass: TClass;
  56. begin
  57.   // protect against misuse
  58.   if pti.Kind <> tkClass then
  59.     raise Exception.Create ('Invalid type information');
  60.  
  61.   // get a pointer to the TTypeData structure
  62.   ptd := GetTypeData (pti);
  63.  
  64.   // access the TTypeInfo structure
  65.   sList.Add ('Type Name: ' + pti.Name);
  66.   sList.Add ('Type Kind: ' + GetEnumName (
  67.     TypeInfo (TTypeKind),
  68.     Integer (pti.Kind)));
  69.  
  70.   // access the TTypeData structure
  71.   {omitted: the same information of pti^.Name...
  72.   sList.Add ('ClassType: ' + ptd^.ClassType.ClassName);}
  73.   sList.Add ('Size: ' + IntToStr (
  74.     ptd.ClassType.InstanceSize) + ' bytes');
  75.   sList.Add ('Defined in: ' + ptd.UnitName + '.pas');
  76.  
  77.   // add the list of parent classes (if any)
  78.   ParentClass := ptd.ClassType.ClassParent;
  79.   if ParentClass <> nil then
  80.   begin
  81.     sList.Add ('');
  82.     sList.Add ('=== Parent classes ===');
  83.     while ParentClass <> nil do
  84.     begin
  85.       sList.Add (ParentClass.ClassName);
  86.       ParentClass := ParentClass.ClassParent;
  87.     end;
  88.   end;
  89.  
  90.   // add the list of properties (if any)
  91.   nProps := ptd.PropCount;
  92.   if nProps > 0 then
  93.   begin
  94.     // format the initial output
  95.     sList.Add ('');
  96.     sList.Add ('=== Properties (' +
  97.       IntToStr (nProps) + ') ===');
  98.     // allocate the required memory
  99.     GetMem (pProps, sizeof (PPropInfo) * nProps);
  100.     // protect the memory allocation
  101.     try
  102.       // fill the TPropList structure
  103.       // pointed to by pProps
  104.       GetPropInfos(pti, pProps);
  105.       // sort the properties
  106.       SortPropList(pProps, nProps);
  107.       // show name and data type of each property
  108.       for I := 0 to nProps - 1 do
  109.       begin
  110.         ppi := pProps [I];
  111.         sList.Add (ppi.Name + ': ' +
  112.           ppi.PropType.Name);
  113.       end;
  114.     finally
  115.       // free the allocated memmory
  116.       FreeMem (pProps, sizeof (PPropInfo) * nProps);
  117.     end;
  118.   end;
  119. end;
  120.  
  121. procedure TForm1.AddType (pti: PTypeInfo);
  122. begin
  123.   ListBox1.Items.AddObject(pti.Name, TObject (pti));
  124. end;
  125.  
  126. procedure TForm1.FormCreate(Sender: TObject);
  127. begin
  128.   // add classes to the first listbox
  129.   AddType (TypeInfo (TApplication));
  130.   AddType (TypeInfo (TAutoIncField));
  131.   AddType (TypeInfo (TBatchMove));
  132.   AddType (TypeInfo (TBCDField));
  133.   AddType (TypeInfo (TBevel));
  134.   AddType (TypeInfo (TBitBtn));
  135.   AddType (TypeInfo (TBitmap));
  136.   AddType (TypeInfo (TBlobField));
  137.   AddType (TypeInfo (TBlobStream));
  138.   AddType (TypeInfo (TBooleanField));
  139.   AddType (TypeInfo (TBrush));
  140.   AddType (TypeInfo (TButton));
  141.   AddType (TypeInfo (TButtonControl));
  142.   AddType (TypeInfo (TBytesField));
  143.   AddType (TypeInfo (TCanvas));
  144.   AddType (TypeInfo (TCaptionProperty));
  145.   AddType (TypeInfo (TChangeLink));
  146.   AddType (TypeInfo (TCharProperty));
  147.   AddType (TypeInfo (TCheckBox));
  148.   AddType (TypeInfo (TClassProperty));
  149.   AddType (TypeInfo (TClipboard));
  150.   AddType (TypeInfo (TCollection));
  151.   AddType (TypeInfo (TCollectionItem));
  152.   AddType (TypeInfo (TColorDialog));
  153.   AddType (TypeInfo (TColorProperty));
  154.   AddType (TypeInfo (TColumn));
  155.   AddType (TypeInfo (TColumnTitle));
  156.   AddType (TypeInfo (TComboBox));
  157.   AddType (TypeInfo (TCommonDialog));
  158.   AddType (TypeInfo (TComponent));
  159.   AddType (TypeInfo (TComponentEditor));
  160.   AddType (TypeInfo (TComponentList));
  161.   AddType (TypeInfo (TComponentProperty));
  162.   AddType (TypeInfo (TControl));
  163.   AddType (TypeInfo (TControlCanvas));
  164.   AddType (TypeInfo (TControlScrollBar));
  165.   AddType (TypeInfo (TCurrencyField));
  166.   AddType (TypeInfo (TCursorProperty));
  167.   AddType (TypeInfo (TCustomCheckBox));
  168.   AddType (TypeInfo (TCustomComboBox));
  169.   AddType (TypeInfo (TCustomControl));
  170.   AddType (TypeInfo (TCustomEdit));
  171.   AddType (TypeInfo (TCustomGrid));
  172.   AddType (TypeInfo (TCustomGroupBox));
  173.   AddType (TypeInfo (TCustomLabel));
  174.   AddType (TypeInfo (TCustomListBox));
  175.   AddType (TypeInfo (TCustomMaskEdit));
  176.   AddType (TypeInfo (TCustomMemo));
  177.   AddType (TypeInfo (TCustomMemoryStream));
  178.   AddType (TypeInfo (TCustomOutline));
  179.   AddType (TypeInfo (TCustomPanel));
  180.   AddType (TypeInfo (TCustomRadioGroup));
  181.   AddType (TypeInfo (TDatabase));
  182.   AddType (TypeInfo (TDataSource));
  183.   AddType (TypeInfo (TDateField));
  184.   AddType (TypeInfo (TDateTimeField));
  185.   AddType (TypeInfo (TDBCheckBox));
  186.   AddType (TypeInfo (TDBComboBox));
  187.   AddType (TypeInfo (TDBCtrlGrid));
  188.   AddType (TypeInfo (TDBEdit));
  189.   AddType (TypeInfo (TDBGrid));
  190.   AddType (TypeInfo (TDBImage));
  191.   AddType (TypeInfo (TDBListBox));
  192.   AddType (TypeInfo (TDBLookupCombo));
  193.   AddType (TypeInfo (TDBLookupList));
  194.   AddType (TypeInfo (TDBLookupListBox));
  195.   AddType (TypeInfo (TDBMemo));
  196.   AddType (TypeInfo (TDBNavigator));
  197.   AddType (TypeInfo (TDBRadioGroup));
  198.   AddType (TypeInfo (TDBText));
  199.   AddType (TypeInfo (TDDEClientConv));
  200.   AddType (TypeInfo (TDDEClientItem));
  201.   AddType (TypeInfo (TDDEServerConv));
  202.   AddType (TypeInfo (TDDEServerItem));
  203.   AddType (TypeInfo (TDefaultEditor));
  204.   AddType (TypeInfo (TDesigner));
  205.   AddType (TypeInfo (TDirectoryListBox));
  206.   AddType (TypeInfo (TDragControlObject));
  207.   AddType (TypeInfo (TDragObject));
  208.   AddType (TypeInfo (TDrawGrid));
  209.   AddType (TypeInfo (TDriveComboBox));
  210.   AddType (TypeInfo (TEdit));
  211.   AddType (TypeInfo (TEnumProperty));
  212.   AddType (TypeInfo (TField));
  213.   AddType (TypeInfo (TFieldDef));
  214.   AddType (TypeInfo (TFieldDefs));
  215.   AddType (TypeInfo (TFileListBox));
  216.   AddType (TypeInfo (TFiler));
  217.   AddType (TypeInfo (TFileStream));
  218.   AddType (TypeInfo (TFilterComboBox));
  219.   AddType (TypeInfo (TFindDialog));
  220.   AddType (TypeInfo (TFloatField));
  221.   AddType (TypeInfo (TFloatProperty));
  222.   AddType (TypeInfo (TFont));
  223.   AddType (TypeInfo (TFontDialog));
  224.   AddType (TypeInfo (TFontNameProperty));
  225.   AddType (TypeInfo (TFontProperty));
  226.   AddType (TypeInfo (TForm));
  227.   AddType (TypeInfo (TFormDesigner));
  228.   AddType (TypeInfo (TGraphic));
  229.   AddType (TypeInfo (TGraphicControl));
  230.   AddType (TypeInfo (TGraphicField));
  231.   AddType (TypeInfo (TGraphicsObject));
  232.   AddType (TypeInfo (TGroupBox));
  233.   AddType (TypeInfo (THandleStream));
  234.   AddType (TypeInfo (THeader));
  235.   AddType (TypeInfo (THeaderControl));
  236.   AddType (TypeInfo (THeaderSection));
  237.   AddType (TypeInfo (THeaderSections));
  238.   AddType (TypeInfo (THintWindow));
  239.   AddType (TypeInfo (THotKey));
  240.   AddType (TypeInfo (TIcon));
  241.   AddType (TypeInfo (TIconOptions));
  242.   AddType (TypeInfo (TImage));
  243.   AddType (TypeInfo (TImage));
  244.   AddType (TypeInfo (TImageList));
  245.   AddType (TypeInfo (TIndexDef));
  246.   AddType (TypeInfo (TIndexDefs));
  247.   AddType (TypeInfo (TIniFile));
  248.   AddType (TypeInfo (TInplaceEdit));
  249.   AddType (TypeInfo (TIntegerField));
  250.   AddType (TypeInfo (TIntegerProperty));
  251.   AddType (TypeInfo (TLabel));
  252.   AddType (TypeInfo (TList));
  253.   AddType (TypeInfo (TListBox));
  254.   AddType (TypeInfo (TListColumn));
  255.   AddType (TypeInfo (TListItem));
  256.   AddType (TypeInfo (TListItems));
  257.   AddType (TypeInfo (TListView));
  258.   AddType (TypeInfo (TMainMenu));
  259.   AddType (TypeInfo (TMaskEdit));
  260.   AddType (TypeInfo (TMediaPlayer));
  261.   AddType (TypeInfo (TMemo));
  262.   AddType (TypeInfo (TMemoField));
  263.   AddType (TypeInfo (TMemoryStream));
  264.   AddType (TypeInfo (TMenu));
  265.   AddType (TypeInfo (TMenuItem));
  266.   AddType (TypeInfo (TMetafile));
  267.   AddType (TypeInfo (TMetafileCanvas));
  268.   AddType (TypeInfo (TMethodProperty));
  269.   AddType (TypeInfo (TModalResultProperty));
  270.   AddType (TypeInfo (TMPFileNameProperty));
  271.   AddType (TypeInfo (TNotebook));
  272.   AddType (TypeInfo (TNotebook));
  273.   AddType (TypeInfo (TObject));
  274.   AddType (TypeInfo (TOleContainer));
  275.   AddType (TypeInfo (TOpenDialog));
  276.   AddType (TypeInfo (TOrdinalProperty));
  277.   AddType (TypeInfo (TOutline));
  278.   AddType (TypeInfo (TOutlineNode));
  279.   AddType (TypeInfo (TPageControl));
  280.   AddType (TypeInfo (TPaintBox));
  281.   AddType (TypeInfo (TPanel));
  282.   AddType (TypeInfo (TParaAttributes));
  283.   AddType (TypeInfo (TParam));
  284.   AddType (TypeInfo (TParams));
  285.   AddType (TypeInfo (TPen));
  286.   AddType (TypeInfo (TPersistent));
  287.   AddType (TypeInfo (TPicture));
  288.   AddType (TypeInfo (TPopupMenu));
  289.   AddType (TypeInfo (TPrintDialog));
  290.   AddType (TypeInfo (TPrinter));
  291.   AddType (TypeInfo (TPrinterSetupDialog));
  292.   AddType (TypeInfo (TProgressBar));
  293.   AddType (TypeInfo (TPropertyEditor));
  294.   AddType (TypeInfo (TQuery));
  295.   AddType (TypeInfo (TRadioButton));
  296.   AddType (TypeInfo (TRadioGroup));
  297.   AddType (TypeInfo (TReader));
  298.   AddType (TypeInfo (TRegIniFile));
  299.   AddType (TypeInfo (TRegistry));
  300.   AddType (TypeInfo (TReplaceDialog));
  301.   AddType (TypeInfo (TReport));
  302.   AddType (TypeInfo (TResourceStream));
  303.   AddType (TypeInfo (TRichEdit));
  304.   AddType (TypeInfo (TSaveDialog));
  305.   AddType (TypeInfo (TScreen));
  306.   AddType (TypeInfo (TScrollBar));
  307.   AddType (TypeInfo (TScrollBox));
  308.   AddType (TypeInfo (TScrollingWinControl));
  309.   AddType (TypeInfo (TSession));
  310.   AddType (TypeInfo (TSetElementProperty));
  311.   AddType (TypeInfo (TSetProperty));
  312.   AddType (TypeInfo (TShape));
  313.   AddType (TypeInfo (TShape));
  314.   AddType (TypeInfo (TShortCutProperty));
  315.   AddType (TypeInfo (TSmallIntField));
  316.   AddType (TypeInfo (TSpeedButton));
  317.   AddType (TypeInfo (TStatusBar));
  318.   AddType (TypeInfo (TStatusPanel));
  319.   AddType (TypeInfo (TStatusPanels));
  320.   AddType (TypeInfo (TStoredProc));
  321.   AddType (TypeInfo (TStream));
  322.   AddType (TypeInfo (TStringField));
  323.   AddType (TypeInfo (TStringList));
  324.   AddType (TypeInfo (TStringProperty));
  325.   AddType (TypeInfo (TStrings));
  326.   AddType (TypeInfo (TStringGrid));
  327.   AddType (TypeInfo (TTabbedNotebook));
  328.   AddType (TypeInfo (TTabControl));
  329.   AddType (TypeInfo (TTable));
  330.   AddType (TypeInfo (TTabOrderProperty));
  331.   AddType (TypeInfo (TTabSet));
  332.   AddType (TypeInfo (TTabSheet));
  333.   AddType (TypeInfo (TTextAttributes));
  334.   AddType (TypeInfo (TThread));
  335.   AddType (TypeInfo (TTimeField));
  336.   AddType (TypeInfo (TTimer));
  337.   AddType (TypeInfo (TTrackBar));
  338.   AddType (TypeInfo (TTreeNode));
  339.   AddType (TypeInfo (TTreeNodes));
  340.   AddType (TypeInfo (TTreeView));
  341.   AddType (TypeInfo (TUpdateSQL));
  342.   AddType (TypeInfo (TUpDown));
  343.   AddType (TypeInfo (TVarBytesField));
  344.   AddType (TypeInfo (TWinControl));
  345.   AddType (TypeInfo (TWordField));
  346.   AddType (TypeInfo (TWriter));
  347.   AddType (TypeInfo (Exception));
  348.   AddType (TypeInfo (EAbort));
  349.   AddType (TypeInfo (EAccessViolation));
  350.   AddType (TypeInfo (EControlC));
  351.   AddType (TypeInfo (EConvertError));
  352.   AddType (TypeInfo (EDivByZero));
  353.   AddType (TypeInfo (EExternalException));
  354.   AddType (TypeInfo (EInOutError));
  355.   AddType (TypeInfo (EIntError));
  356.   AddType (TypeInfo (EIntOverFlow));
  357.   AddType (TypeInfo (EInvalidCast));
  358.   AddType (TypeInfo (EInvalidOp));
  359.   AddType (TypeInfo (EInvalidPointer));
  360.   AddType (TypeInfo (EMathError));
  361.   AddType (TypeInfo (EOutOfMemory));
  362.   AddType (TypeInfo (EOverflow));
  363.   AddType (TypeInfo (EPrivilege));
  364.   AddType (TypeInfo (EPropReadOnly));
  365.   AddType (TypeInfo (EPropWriteOnly));
  366.   AddType (TypeInfo (ERangeError));
  367.   AddType (TypeInfo (EStackOverflow));
  368.   AddType (TypeInfo (EUnderflow));
  369.   AddType (TypeInfo (EVariantError));
  370.   AddType (TypeInfo (EZeroDivide));
  371. end;
  372.  
  373. // code extracted from TypInfo.pas
  374. procedure SortPropList(PropList: PPropList; PropCount: Integer); assembler;
  375. asm
  376.         { ->    EAX Pointer to prop list        }
  377.         {       EDX Property count              }
  378.         { <-    nothing                         }
  379.  
  380.         PUSH    EBX
  381.         PUSH    ESI
  382.         PUSH    EDI
  383.         MOV     ECX,EAX
  384.         XOR     EAX,EAX
  385.         DEC     EDX
  386.         CALL    @@qsort
  387.         POP     EDI
  388.         POP     ESI
  389.         POP     EBX
  390.         JMP     @@exit
  391.  
  392. @@qsort:
  393.         PUSH    EAX
  394.         PUSH    EDX
  395.         LEA     EDI,[EAX+EDX]           { pivot := (left + right) div 2 }
  396.         SHR     EDI,1
  397.         MOV     EDI,[ECX+EDI*4]
  398.         ADD     EDI,OFFSET TPropInfo.Name
  399. @@repeat:                               { repeat                        }
  400. @@while1:
  401.         CALL    @@compare               { while a[i] < a[pivot] do inc(i);}
  402.         JAE     @@endWhile1
  403.         INC     EAX
  404.         JMP     @@while1
  405. @@endWhile1:
  406.         XCHG    EAX,EDX
  407. @@while2:
  408.         CALL    @@compare               { while a[j] > a[pivot] do dec(j);}
  409.         JBE     @@endWhile2
  410.         DEC     EAX
  411.         JMP     @@while2
  412. @@endWhile2:
  413.         XCHG    EAX,EDX
  414.         CMP     EAX,EDX                 { if i <= j then begin          }
  415.         JG      @@endRepeat
  416.         MOV     EBX,[ECX+EAX*4]         { x := a[i];                    }
  417.         MOV     ESI,[ECX+EDX*4]         { y := a[j];                    }
  418.         MOV     [ECX+EDX*4],EBX         { a[j] := x;                    }
  419.         MOV     [ECX+EAX*4],ESI         { a[i] := y;                    }
  420.         INC     EAX                     { inc(i);                       }
  421.         DEC     EDX                     { dec(j);                       }
  422.                                         { end;                          }
  423.         CMP     EAX,EDX                 { until i > j;                  }
  424.         JLE     @@repeat
  425.  
  426. @@endRepeat:
  427.         POP     ESI
  428.         POP     EBX
  429.  
  430.         CMP     EAX,ESI
  431.         JL      @@rightNonEmpty         { if i >= right then begin      }
  432.         CMP     EDX,EBX
  433.         JG      @@leftNonEmpty1         { if j <= left then exit        }
  434.         RET
  435.  
  436. @@leftNonEmpty1:
  437.         MOV     EAX,EBX
  438.         JMP     @@qsort                 { qsort(left, j)                }
  439.  
  440. @@rightNonEmpty:
  441.         CMP     EAX,EBX
  442.         JG      @@leftNonEmpty2
  443.         MOV     EDX,ESI                 { qsort(i, right)               }
  444.         JMP     @@qsort
  445. @@leftNonEmpty2:
  446.         PUSH    EAX
  447.         PUSH    ESI
  448.         MOV     EAX,EBX
  449.         CALL    @@qsort                 { qsort(left, j)                }
  450.         POP     EDX
  451.         POP     EAX
  452.         JMP     @@qsort                 { qsort(i, right)               }
  453.  
  454. @@compare:
  455.         PUSH    EAX
  456.         PUSH    EDI
  457.         MOV     ESI,[ECX+EAX*4]
  458.         ADD     ESI,OFFSET TPropInfo.Name
  459.         PUSH    ESI
  460.         XOR     EBX,EBX
  461.         MOV     BL,[ESI]
  462.         INC     ESI
  463.         CMP     BL,[EDI]
  464.         JBE     @@firstLenSmaller
  465.         MOV     BL,[EDI]
  466. @@firstLenSmaller:
  467.         INC     EDI
  468.         TEST    BL,BL
  469.         JE      @@endLoop
  470. @@loop:
  471.         MOV     AL,[ESI]
  472.         MOV     AH,[EDI]
  473.         AND     EAX,$DFDF
  474.         CMP     AL,AH
  475.         JNE     @@difference
  476.         INC     ESI
  477.         INC     EDI
  478.         DEC     EBX
  479.         JNZ     @@loop
  480. @@endLoop:
  481.         POP     ESI
  482.         POP     EDI
  483.         MOV     AL,[ESI]
  484.         MOV     AH,[EDI]
  485.         CMP     AL,AH
  486.         POP     EAX
  487.         RET
  488. @@difference:
  489.         POP     ESI
  490.         POP     EDI
  491.         POP     EAX
  492.         RET
  493. @@exit:
  494. end;
  495.  
  496. procedure TForm1.ListBox2Click(Sender: TObject);
  497. var
  498.   Text: string;
  499.   Index: Integer;
  500.   pti: PTypeInfo;
  501. begin
  502.   // get the current item
  503.   Text := ListBox2.Items [ListBox2.ItemIndex];
  504.   // search the first listbox
  505.   Index := ListBox1.Items.IndexOf (Text);
  506.   // if found, it was a parent class: show RTTI
  507.   if Index >= 0 then
  508.   begin
  509.     pti := PTypeInfo (ListBox1.Items.Objects [Index]);
  510.     Label1.Caption := 'RTTI information for ' + Text;
  511.     ListBox2.Items.Clear;
  512.     ShowClass (pti, ListBox2.Items);
  513.   end;
  514. end;
  515.  
  516. end.
  517.